home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / examples / xm / option-menu < prev    next >
Encoding:
Text File  |  1992-10-01  |  1.1 KB  |  35 lines
  1. ;;; -*-Scheme-*-
  2. ;;;
  3. ;;; Option menu demo
  4.  
  5. (require 'motif)
  6. (load-widgets shell row-column cascade-button push-button label separator)
  7. (load 'menu-stuff)
  8.  
  9. (define top (application-initialize 'option))
  10.  
  11. (define rc (create-managed-widget (find-class 'row-column) top))
  12. (set-values! rc 'orientation "horizontal")
  13.  
  14. (define menu-1 (create-pulldown-menu rc))
  15.  
  16. (define b1 (menu-add-button! menu-1 'label-string "Option 1"))
  17. (define b2 (menu-add-button! menu-1 'label-string "Option 2"))
  18. (define b3 (menu-add-button! menu-1 'label-string "Option 3"))
  19. (define b4 (menu-add-button! menu-1 'label-string "Option 4"))
  20.  
  21. (define menu-2 (create-pulldown-menu rc))
  22.  
  23. (define ba (menu-add-button! menu-2 'label-string "Option A"))
  24. (define bb (menu-add-button! menu-2 'label-string "Option B"))
  25. (define bc (menu-add-button! menu-2 'label-string "Option C"))
  26.  
  27. (create-option-menu rc 'sub-menu-id menu-1 'menu-history b3
  28.             'label-string "first option" 'mnemonic #\f)
  29.  
  30. (create-option-menu rc 'sub-menu-id menu-2 'menu-history ba
  31.             'label-string "second option" 'mnemonic #\s)
  32.  
  33. (realize-widget top)
  34. (context-main-loop (widget-context top))
  35.